home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / xlisp.lbr / XLPRIN.CQ / xlprin.c
Encoding:
C/C++ Source or Header  |  1985-06-03  |  5.1 KB  |  221 lines
  1.  
  2.                        /* xlprint - xlisp print routine */
  3.  
  4. #ifdef CI_86
  5. #include "a:stdio.h"
  6. #include "xlisp.h"
  7. #endif
  8.  
  9. #ifdef AZTEC
  10. #include "a:stdio.h"
  11. #include "xlisp.h"
  12. #endif
  13.  
  14. #ifdef unix
  15. #include <stdio.h>
  16. #include <xlisp.h>
  17. #endif
  18.  
  19.  
  20.                             /* external variables */
  21.  
  22. extern struct node *xlstack;
  23.  
  24.  
  25.                               /* local variables */
  26.  
  27. static struct node *printsym;
  28.  
  29.  
  30.                       /***********************************
  31.                       *  print - builtin function print  *
  32.                       ***********************************/
  33.  
  34. static struct node *print(args)
  35.   struct node *args;
  36. {
  37.     xprint(args,TRUE);
  38. }
  39.  
  40.  
  41.                       /***********************************
  42.                       *  princ - builtin function princ  *
  43.                       ***********************************/
  44.  
  45. static struct node *princ(args)
  46.   struct node *args;
  47. {
  48.     xprint(args,FALSE);
  49. }
  50.  
  51.  
  52.                       /***********************************
  53.                       *  xprint - common print function  *
  54.                       ***********************************/
  55.  
  56. xprint(args,flag)
  57.   struct node *args; int flag;
  58. {
  59.     struct node *oldstk,arg,val;
  60.  
  61.     oldstk = xlsave(&arg,&val,NULL);        /* New stack frame */
  62.     arg.n_ptr = args;
  63.  
  64.     while (arg.n_ptr != NULL)               /* Evaluate an print each arg */
  65.         xlprint(xlevarg(&arg.n_ptr),flag);
  66.  
  67.     xlstack = oldstk;                       /* Restore old stack frame */
  68.     return (NULL);
  69. }
  70.  
  71.  
  72.                       /***********************************
  73.                       *  xlprint - print an xlisp value  *
  74.                       ***********************************/
  75.  
  76. xlprint(vptr,flag)
  77.   struct node *vptr; int flag;
  78. {
  79.     struct node *nptr,*next,*msg;
  80.  
  81. #ifdef FGETNAME
  82.     char buffer[128];
  83. #endif
  84.  
  85.     if (vptr == NULL)                  /* Print NULL as the empty list */
  86.     {
  87.         printf("()");
  88.         return;
  89.     }
  90.  
  91.     switch (vptr->n_type)              /* Check value type */
  92.     {
  93.     case SUBR:
  94.             printf("<Subr: #%o>",vptr);
  95.             break;
  96.  
  97.     case LIST:
  98.             putchar('(');
  99.             for (nptr = vptr; nptr != NULL; nptr = next)
  100.             {
  101.                 xlprint(nptr->n_listvalue,flag);
  102.                 if ((next = nptr->n_listnext) != NULL)
  103.                     if (next->n_type == LIST)
  104.                         putchar(' ');
  105.                     else
  106.                     {
  107.                         putchar('.');
  108.                         xlprint(next,flag);
  109.                         break;
  110.                     }
  111.             }
  112.             putchar(')');
  113.             break;
  114.  
  115.     case SYM:
  116.             printf("%s",vptr->n_symname);
  117.             break;
  118.  
  119.     case INT:
  120.             printf("%d",vptr->n_int);
  121.             break;
  122.  
  123. #ifdef REALS
  124.     case REAL:
  125.             printf("%g",vptr->n_real);
  126.             break;
  127. #endif
  128.  
  129.     case STR:
  130.             if (flag)
  131.                 putstring(vptr->n_str);
  132.             else
  133.                 printf("%s",vptr->n_str);
  134.             break;
  135.  
  136.     case FPTR:
  137.  
  138. #ifdef FGETNAME
  139.             printf("<File: %s>",fgetname(vptr->n_fp, buffer));
  140. #else
  141.             printf("<File: #%o>",vptr);
  142. #endif
  143.             break;
  144.  
  145.     case OBJ:
  146.             if ((msg = xlmfind(vptr,printsym)) == NULL)
  147.                 xlfail("no print message");
  148.             xlxsend(vptr,msg,NULL);
  149.             break;
  150.  
  151.     case KMAP:
  152.             printf("<Kmap: #%o>",vptr);
  153.             break;
  154.  
  155.     default:
  156.             printf("Invalid node type %d", vptr->n_type);
  157.             break;
  158.     }
  159. }
  160.  
  161.  
  162.                         /********************************
  163.                         *  putstring - output a string  *
  164.                         ********************************/
  165.  
  166. static putstring(str)
  167.   char *str;
  168. {
  169.     int ch;
  170.  
  171.     putchar('"');
  172.     while (ch = *str++)
  173.         if (ch < 040 || ch == '\\')              /* Check for control char */
  174.         {
  175.             putchar('\\');
  176.             switch (ch)
  177.             {
  178.             case '\033':
  179.                     putchar('e');
  180.                     break;
  181.  
  182.             case '\n':
  183.                     putchar('n');
  184.                     break;
  185.  
  186.             case '\r':
  187.                     putchar('r');
  188.                     break;
  189.  
  190.             case '\t':
  191.                     putchar('t');
  192.                     break;
  193.  
  194.             case '\\':
  195.                     putchar('\\');
  196.                     break;
  197.  
  198.             default:
  199.                     printf("%03o",ch);
  200.                     break;
  201.             }
  202.         }
  203.         else                           /* Output a normal char */
  204.             putchar(ch);
  205.  
  206.     putchar('"');
  207. }
  208.  
  209.  
  210.                   /********************************************
  211.                   *  xlpinit - initialize the print routines  *
  212.                   ********************************************/
  213.  
  214. xlpinit()
  215. {
  216.     printsym = xlenter("print");            /* Find the print symbol */
  217.  
  218.     xlsubr("print",print);                  /* Enter the built in functions */
  219.     xlsubr("princ",princ);
  220. }
  221.